<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html xmlns="http://www.w3.org/1999/xhtml"><head><link rel="stylesheet" type="text/css" href="style.css" /><script type="text/javascript" src="highlight.js"></script></head><body><pre><span class="hs-pragma">{-# LANGUAGE CPP #-}</span><span>
</span><span id="line-2"></span><span class="hs-pragma">{-# LANGUAGE ScopedTypeVariables #-}</span><span class="hs-cpp">
#if __GLASGOW_HASKELL__ &gt;= 701
</span><span class="hs-pragma">{-# LANGUAGE Trustworthy #-}</span><span class="hs-cpp">
#endif
</span><span class="hs-comment">-- |</span><span>
</span><span id="line-7"></span><span class="hs-comment">-- Copyright   : (c) 2010 Simon Meier</span><span>
</span><span id="line-8"></span><span class="hs-comment">--</span><span>
</span><span id="line-9"></span><span class="hs-comment">-- License     : BSD3-style (see LICENSE)</span><span>
</span><span id="line-10"></span><span class="hs-comment">--</span><span>
</span><span id="line-11"></span><span class="hs-comment">-- Maintainer  : Simon Meier &lt;iridcode@gmail.com&gt;</span><span>
</span><span id="line-12"></span><span class="hs-comment">-- Stability   : experimental</span><span>
</span><span id="line-13"></span><span class="hs-comment">-- Portability : GHC</span><span>
</span><span id="line-14"></span><span class="hs-comment">--</span><span>
</span><span id="line-15"></span><span class="hs-comment">-- Conversion of 'Float's and 'Double's to 'Word32's and 'Word64's.</span><span>
</span><span id="line-16"></span><span class="hs-comment">--</span><span>
</span><span id="line-17"></span><span class="hs-keyword">module</span><span> </span><span class="hs-identifier">Data.ByteString.Builder.Prim.Internal.Floating</span><span>
</span><span id="line-18"></span><span>    </span><span class="hs-special">(</span><span>
</span><span id="line-19"></span><span>      </span><span class="hs-comment">-- coerceFloatToWord32</span><span>
</span><span id="line-20"></span><span>    </span><span class="hs-comment">-- , coerceDoubleToWord64</span><span>
</span><span id="line-21"></span><span>    </span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.Floating.html#encodeFloatViaWord32F"><span class="hs-identifier">encodeFloatViaWord32F</span></a></span><span>
</span><span id="line-22"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.Floating.html#encodeDoubleViaWord64F"><span class="hs-identifier">encodeDoubleViaWord64F</span></a></span><span>
</span><span id="line-23"></span><span>  </span><span class="hs-special">)</span><span> </span><span class="hs-keyword">where</span><span>
</span><span id="line-24"></span><span>
</span><span id="line-25"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="../../base/src/Foreign.html#"><span class="hs-identifier">Foreign</span></a></span><span>
</span><span id="line-26"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.html"><span class="hs-identifier">Data.ByteString.Builder.Prim.Internal</span></a></span><span>
</span><span id="line-27"></span><span>
</span><span id="line-28"></span><span class="hs-comment">{-
We work around ticket http://ghc.haskell.org/trac/ghc/ticket/4092 using the
FFI to store the Float/Double in the buffer and peek it out again from there.
-}</span><span>
</span><span id="line-32"></span><span>
</span><span id="line-33"></span><span>
</span><span id="line-34"></span><span class="hs-comment">-- | Encode a 'Float' using a 'Word32' encoding.</span><span>
</span><span id="line-35"></span><span class="hs-comment">--</span><span>
</span><span id="line-36"></span><span class="hs-comment">-- PRE: The 'Word32' encoding must have a size of at least 4 bytes.</span><span>
</span><span id="line-37"></span><span class="hs-pragma">{-# INLINE</span><span> </span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.Floating.html#encodeFloatViaWord32F"><span class="hs-pragma hs-type">encodeFloatViaWord32F</span></a></span><span> </span><span class="hs-pragma">#-}</span><span>
</span><span id="line-38"></span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.Floating.html#encodeFloatViaWord32F"><span class="hs-identifier hs-type">encodeFloatViaWord32F</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.html#FixedPrim"><span class="hs-identifier hs-type">FixedPrim</span></a></span><span> </span><span class="annot"><a href="../../base/src/GHC.Word.html#Word32"><span class="hs-identifier hs-type">Word32</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.html#FixedPrim"><span class="hs-identifier hs-type">FixedPrim</span></a></span><span> </span><span class="annot"><a href="../../ghc-prim/src/GHC.Types.html#Float"><span class="hs-identifier hs-type">Float</span></a></span><span>
</span><span id="line-39"></span><span id="encodeFloatViaWord32F"><span class="annot"><span class="annottext">encodeFloatViaWord32F :: FixedPrim Word32 -&gt; FixedPrim Float
</span><a href="Data.ByteString.Builder.Prim.Internal.Floating.html#encodeFloatViaWord32F"><span class="hs-identifier hs-var hs-var">encodeFloatViaWord32F</span></a></span></span><span> </span><span id="local-6989586621679070667"><span class="annot"><span class="annottext">FixedPrim Word32
</span><a href="#local-6989586621679070667"><span class="hs-identifier hs-var">w32fe</span></a></span></span><span>
</span><span id="line-40"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">FixedPrim Word32 -&gt; Int
forall a. FixedPrim a -&gt; Int
</span><a href="Data.ByteString.Builder.Prim.Internal.html#size"><span class="hs-identifier hs-var">size</span></a></span><span> </span><span class="annot"><span class="annottext">FixedPrim Word32
</span><a href="#local-6989586621679070667"><span class="hs-identifier hs-var">w32fe</span></a></span><span> </span><span class="annot"><span class="annottext">Int -&gt; Int -&gt; Bool
forall a. Ord a =&gt; a -&gt; a -&gt; Bool
</span><a href="../../ghc-prim/src/GHC.Classes.html#%3C"><span class="hs-operator hs-var">&lt;</span></a></span><span> </span><span class="annot"><span class="annottext">Float -&gt; Int
forall a. Storable a =&gt; a -&gt; Int
</span><a href="../../base/src/Foreign.Storable.html#sizeOf"><span class="hs-identifier hs-var">sizeOf</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Float
forall a. HasCallStack =&gt; a
</span><a href="../../base/src/GHC.Err.html#undefined"><span class="hs-identifier hs-var">undefined</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="../../ghc-prim/src/GHC.Types.html#Float"><span class="hs-identifier hs-type">Float</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-41"></span><span>      </span><span class="annot"><span class="annottext">[Char] -&gt; FixedPrim Float
forall a. HasCallStack =&gt; [Char] -&gt; a
</span><a href="../../base/src/GHC.Err.html#error"><span class="hs-identifier hs-var">error</span></a></span><span> </span><span class="annot"><span class="annottext">([Char] -&gt; FixedPrim Float) -&gt; [Char] -&gt; FixedPrim Float
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="../../base/src/GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span> </span><span class="annot"><span class="annottext">[Char]
</span><span class="hs-string">&quot;encodeFloatViaWord32F: encoding not wide enough&quot;</span></span><span>
</span><span id="line-42"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Int -&gt; (Float -&gt; Ptr Word8 -&gt; IO ()) -&gt; FixedPrim Float
forall a. Int -&gt; (a -&gt; Ptr Word8 -&gt; IO ()) -&gt; FixedPrim a
</span><a href="Data.ByteString.Builder.Prim.Internal.html#fixedPrim"><span class="hs-identifier hs-var">fixedPrim</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">FixedPrim Word32 -&gt; Int
forall a. FixedPrim a -&gt; Int
</span><a href="Data.ByteString.Builder.Prim.Internal.html#size"><span class="hs-identifier hs-var">size</span></a></span><span> </span><span class="annot"><span class="annottext">FixedPrim Word32
</span><a href="#local-6989586621679070667"><span class="hs-identifier hs-var">w32fe</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">((Float -&gt; Ptr Word8 -&gt; IO ()) -&gt; FixedPrim Float)
-&gt; (Float -&gt; Ptr Word8 -&gt; IO ()) -&gt; FixedPrim Float
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="../../base/src/GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span> </span><span class="hs-glyph">\</span><span id="local-6989586621679070660"><span class="annot"><span class="annottext">Float
</span><a href="#local-6989586621679070660"><span class="hs-identifier hs-var">x</span></a></span></span><span> </span><span id="local-6989586621679070659"><span class="annot"><span class="annottext">Ptr Word8
</span><a href="#local-6989586621679070659"><span class="hs-identifier hs-var">op</span></a></span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-43"></span><span>      </span><span class="annot"><span class="annottext">Ptr Float -&gt; Float -&gt; IO ()
forall a. Storable a =&gt; Ptr a -&gt; a -&gt; IO ()
</span><a href="../../base/src/Foreign.Storable.html#poke"><span class="hs-identifier hs-var">poke</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Ptr Word8 -&gt; Ptr Float
forall a b. Ptr a -&gt; Ptr b
</span><a href="../../base/src/GHC.Ptr.html#castPtr"><span class="hs-identifier hs-var">castPtr</span></a></span><span> </span><span class="annot"><span class="annottext">Ptr Word8
</span><a href="#local-6989586621679070659"><span class="hs-identifier hs-var">op</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">Float
</span><a href="#local-6989586621679070660"><span class="hs-identifier hs-var">x</span></a></span><span>
</span><span id="line-44"></span><span>      </span><span id="local-6989586621679070656"><span class="annot"><span class="annottext">Word32
</span><a href="#local-6989586621679070656"><span class="hs-identifier hs-var">x'</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Ptr Word32 -&gt; IO Word32
forall a. Storable a =&gt; Ptr a -&gt; IO a
</span><a href="../../base/src/Foreign.Storable.html#peek"><span class="hs-identifier hs-var">peek</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Ptr Word8 -&gt; Ptr Word32
forall a b. Ptr a -&gt; Ptr b
</span><a href="../../base/src/GHC.Ptr.html#castPtr"><span class="hs-identifier hs-var">castPtr</span></a></span><span> </span><span class="annot"><span class="annottext">Ptr Word8
</span><a href="#local-6989586621679070659"><span class="hs-identifier hs-var">op</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-45"></span><span>      </span><span class="annot"><span class="annottext">FixedPrim Word32 -&gt; Word32 -&gt; Ptr Word8 -&gt; IO ()
forall a. FixedPrim a -&gt; a -&gt; Ptr Word8 -&gt; IO ()
</span><a href="Data.ByteString.Builder.Prim.Internal.html#runF"><span class="hs-identifier hs-var">runF</span></a></span><span> </span><span class="annot"><span class="annottext">FixedPrim Word32
</span><a href="#local-6989586621679070667"><span class="hs-identifier hs-var">w32fe</span></a></span><span> </span><span class="annot"><span class="annottext">Word32
</span><a href="#local-6989586621679070656"><span class="hs-identifier hs-var">x'</span></a></span><span> </span><span class="annot"><span class="annottext">Ptr Word8
</span><a href="#local-6989586621679070659"><span class="hs-identifier hs-var">op</span></a></span><span>
</span><span id="line-46"></span><span>
</span><span id="line-47"></span><span class="hs-comment">-- | Encode a 'Double' using a 'Word64' encoding.</span><span>
</span><span id="line-48"></span><span class="hs-comment">--</span><span>
</span><span id="line-49"></span><span class="hs-comment">-- PRE: The 'Word64' encoding must have a size of at least 8 bytes.</span><span>
</span><span id="line-50"></span><span class="hs-pragma">{-# INLINE</span><span> </span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.Floating.html#encodeDoubleViaWord64F"><span class="hs-pragma hs-type">encodeDoubleViaWord64F</span></a></span><span> </span><span class="hs-pragma">#-}</span><span>
</span><span id="line-51"></span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.Floating.html#encodeDoubleViaWord64F"><span class="hs-identifier hs-type">encodeDoubleViaWord64F</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.html#FixedPrim"><span class="hs-identifier hs-type">FixedPrim</span></a></span><span> </span><span class="annot"><a href="../../base/src/GHC.Word.html#Word64"><span class="hs-identifier hs-type">Word64</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="Data.ByteString.Builder.Prim.Internal.html#FixedPrim"><span class="hs-identifier hs-type">FixedPrim</span></a></span><span> </span><span class="annot"><a href="../../ghc-prim/src/GHC.Types.html#Double"><span class="hs-identifier hs-type">Double</span></a></span><span>
</span><span id="line-52"></span><span id="encodeDoubleViaWord64F"><span class="annot"><span class="annottext">encodeDoubleViaWord64F :: FixedPrim Word64 -&gt; FixedPrim Double
</span><a href="Data.ByteString.Builder.Prim.Internal.Floating.html#encodeDoubleViaWord64F"><span class="hs-identifier hs-var hs-var">encodeDoubleViaWord64F</span></a></span></span><span> </span><span id="local-6989586621679070653"><span class="annot"><span class="annottext">FixedPrim Word64
</span><a href="#local-6989586621679070653"><span class="hs-identifier hs-var">w64fe</span></a></span></span><span>
</span><span id="line-53"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">FixedPrim Word64 -&gt; Int
forall a. FixedPrim a -&gt; Int
</span><a href="Data.ByteString.Builder.Prim.Internal.html#size"><span class="hs-identifier hs-var">size</span></a></span><span> </span><span class="annot"><span class="annottext">FixedPrim Word64
</span><a href="#local-6989586621679070653"><span class="hs-identifier hs-var">w64fe</span></a></span><span> </span><span class="annot"><span class="annottext">Int -&gt; Int -&gt; Bool
forall a. Ord a =&gt; a -&gt; a -&gt; Bool
</span><a href="../../ghc-prim/src/GHC.Classes.html#%3C"><span class="hs-operator hs-var">&lt;</span></a></span><span> </span><span class="annot"><span class="annottext">Float -&gt; Int
forall a. Storable a =&gt; a -&gt; Int
</span><a href="../../base/src/Foreign.Storable.html#sizeOf"><span class="hs-identifier hs-var">sizeOf</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Float
forall a. HasCallStack =&gt; a
</span><a href="../../base/src/GHC.Err.html#undefined"><span class="hs-identifier hs-var">undefined</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="../../ghc-prim/src/GHC.Types.html#Float"><span class="hs-identifier hs-type">Float</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-54"></span><span>      </span><span class="annot"><span class="annottext">[Char] -&gt; FixedPrim Double
forall a. HasCallStack =&gt; [Char] -&gt; a
</span><a href="../../base/src/GHC.Err.html#error"><span class="hs-identifier hs-var">error</span></a></span><span> </span><span class="annot"><span class="annottext">([Char] -&gt; FixedPrim Double) -&gt; [Char] -&gt; FixedPrim Double
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="../../base/src/GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span> </span><span class="annot"><span class="annottext">[Char]
</span><span class="hs-string">&quot;encodeDoubleViaWord64F: encoding not wide enough&quot;</span></span><span>
</span><span id="line-55"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Int -&gt; (Double -&gt; Ptr Word8 -&gt; IO ()) -&gt; FixedPrim Double
forall a. Int -&gt; (a -&gt; Ptr Word8 -&gt; IO ()) -&gt; FixedPrim a
</span><a href="Data.ByteString.Builder.Prim.Internal.html#fixedPrim"><span class="hs-identifier hs-var">fixedPrim</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">FixedPrim Word64 -&gt; Int
forall a. FixedPrim a -&gt; Int
</span><a href="Data.ByteString.Builder.Prim.Internal.html#size"><span class="hs-identifier hs-var">size</span></a></span><span> </span><span class="annot"><span class="annottext">FixedPrim Word64
</span><a href="#local-6989586621679070653"><span class="hs-identifier hs-var">w64fe</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">((Double -&gt; Ptr Word8 -&gt; IO ()) -&gt; FixedPrim Double)
-&gt; (Double -&gt; Ptr Word8 -&gt; IO ()) -&gt; FixedPrim Double
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="../../base/src/GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span> </span><span class="hs-glyph">\</span><span id="local-6989586621679070652"><span class="annot"><span class="annottext">Double
</span><a href="#local-6989586621679070652"><span class="hs-identifier hs-var">x</span></a></span></span><span> </span><span id="local-6989586621679070651"><span class="annot"><span class="annottext">Ptr Word8
</span><a href="#local-6989586621679070651"><span class="hs-identifier hs-var">op</span></a></span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-56"></span><span>      </span><span class="annot"><span class="annottext">Ptr Double -&gt; Double -&gt; IO ()
forall a. Storable a =&gt; Ptr a -&gt; a -&gt; IO ()
</span><a href="../../base/src/Foreign.Storable.html#poke"><span class="hs-identifier hs-var">poke</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Ptr Word8 -&gt; Ptr Double
forall a b. Ptr a -&gt; Ptr b
</span><a href="../../base/src/GHC.Ptr.html#castPtr"><span class="hs-identifier hs-var">castPtr</span></a></span><span> </span><span class="annot"><span class="annottext">Ptr Word8
</span><a href="#local-6989586621679070651"><span class="hs-identifier hs-var">op</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">Double
</span><a href="#local-6989586621679070652"><span class="hs-identifier hs-var">x</span></a></span><span>
</span><span id="line-57"></span><span>      </span><span id="local-6989586621679070650"><span class="annot"><span class="annottext">Word64
</span><a href="#local-6989586621679070650"><span class="hs-identifier hs-var">x'</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Ptr Word64 -&gt; IO Word64
forall a. Storable a =&gt; Ptr a -&gt; IO a
</span><a href="../../base/src/Foreign.Storable.html#peek"><span class="hs-identifier hs-var">peek</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Ptr Word8 -&gt; Ptr Word64
forall a b. Ptr a -&gt; Ptr b
</span><a href="../../base/src/GHC.Ptr.html#castPtr"><span class="hs-identifier hs-var">castPtr</span></a></span><span> </span><span class="annot"><span class="annottext">Ptr Word8
</span><a href="#local-6989586621679070651"><span class="hs-identifier hs-var">op</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-58"></span><span>      </span><span class="annot"><span class="annottext">FixedPrim Word64 -&gt; Word64 -&gt; Ptr Word8 -&gt; IO ()
forall a. FixedPrim a -&gt; a -&gt; Ptr Word8 -&gt; IO ()
</span><a href="Data.ByteString.Builder.Prim.Internal.html#runF"><span class="hs-identifier hs-var">runF</span></a></span><span> </span><span class="annot"><span class="annottext">FixedPrim Word64
</span><a href="#local-6989586621679070653"><span class="hs-identifier hs-var">w64fe</span></a></span><span> </span><span class="annot"><span class="annottext">Word64
</span><a href="#local-6989586621679070650"><span class="hs-identifier hs-var">x'</span></a></span><span> </span><span class="annot"><span class="annottext">Ptr Word8
</span><a href="#local-6989586621679070651"><span class="hs-identifier hs-var">op</span></a></span><span>
</span><span id="line-59"></span><span>
</span><span id="line-60"></span></pre></body></html>